1. PPS Data Preparation
Clean up codebook
Clean pp so it only has relevant variables
Code
[1] 172
Code
[1] 96
Make it long and merge reverse code from codebook and reverse code
Code
pp_long_updated <- pp_wide %>%
pivot_longer(
cols = -c(SID:HourBlock1, all_beeps),
names_to = "trait",
values_to = "value"
) %>%
rename("New #" = "trait") #for merging codebook; we'll change it back
pp_long_updated <- pp_long_updated %>%
left_join(
pp_codebook %>%
select('New #', Reverse, Facet, Inventory, Trait, 'Modified Item')
)Joining with `by = join_by(`New #`)`
Create facets
Code
#first, subset traits
pp_long_traits <- pp_long_updated %>%
filter(Inventory == "BFI-2") %>%
group_by(SID, Date, Facet, Day, Hour, HourBlock, HourBlock1, all_beeps) %>%
mutate(facet_value = mean(value, na.rm =TRUE)) %>% #mean score on facet
distinct_at(vars(SID, Date, Facet, facet_value)) %>% #keep unique rows
mutate_all(~ifelse(is.nan(.), NA, .)) %>%
arrange(SID, Date) %>%
ungroup()`mutate_all()` ignored the following grouping variables:
• Columns `SID`, `Date`, `Facet`, `Day`, `Hour`, ...
ℹ Use `mutate_at(df, vars(-group_cols()), myoperation)` to silence the message.
Code
#subset emotion and diamonds
pp_long_emo <- pp_long_updated %>%
filter(Inventory == "Affect") %>%
select(c(SID:all_beeps, value, 'Modified Item')) %>%
rename("Facet" = 'Modified Item')
pp_long_sit <- pp_long_updated %>%
filter(Inventory == "S8-I") %>%
select(c(SID:all_beeps, value, Trait)) %>%
rename("Facet" = 'Trait')
#join all three dfs
pp_long_comp <- full_join(pp_long_traits, pp_long_emo) Joining with `by = join_by(Day, Hour, HourBlock, HourBlock1, all_beeps, SID,
Date, Facet)`
Joining with `by = join_by(Day, Hour, HourBlock, HourBlock1, all_beeps, SID,
Date, Facet, value)`
Make it wide again
Code
How much missingness of facets before imputation?
[1] 0.2168373
IMPUTATION TIME BABY
Code
Warning in amcheck(x = x, m = m, idvars = numopts$idvars, priors = priors, : The variable Deception is perfectly collinear with another variable in the data.
Warning: There are observations in the data that are completely missing.
These observations will remain unimputed in the final datasets.
-- Imputation 1 --
1 2 3 4 5 6 7 8 9 10 11
Joining with `by = join_by(SID, all_beeps)`
Code
Code
# restrict range of state values after MI
pp <- pp_mi[,2:16]
pp[ pp > 5 ] <- 5
pp[ pp < 1] <- 1
sits <- pp_mi[,27:34]
sits[ sits > 3 ] <- 3
sits[ sits < 1] <- 1
#recombine
pp_mi_range <- cbind(pp_mi$SID, pp_mi$Date, pp_mi$Hour, pp_mi$HourBlock1, pp)
pp_mi_range_sit <- cbind(pp_mi$SID, pp_mi$Date, pp, sits)
#order columns
colnames(pp_mi_range_sit) [1] "pp_mi$SID" "pp_mi$Date" "Compassion"
[4] "Respectfulness" "Trust" "Organization"
[7] "Productiveness" "Responsibility" "Sociability"
[10] "Assertiveness" "Energy.Level" "Anxiety"
[13] "Depression" "Emotional.Volatility" "Intellectual.Curiosity"
[16] "Aesthetic.Sensitivity" "Creative.Imagination" "Duty"
[19] "Intellect" "Adversity" "Mating"
[22] "pOsitivity" "Negativity" "Deception"
[25] "Sociality"
Code
colnames(pp_mi_range) <- c("SID", "Date", "Hour", "HourBlock1", "Sociability", "EnergyLevel", "Assertive", "Trust", "Respect", "Compassion", "Productivity", "Responsibility", "Organization", "Depression", "Anxiety", "EmotionalVol", "IntCuriosity", "AesthSense", "CrtvImagination")
sit_names <- colnames(pp_mi_range_sit[18:25])
colnames(pp_mi_range_sit) <- c("SID", "Date", "Sociability", "EnergyLevel", "Assertive", "Trust", "Respect", "Compassion", "Productivity", "Responsibility", "Organization", "Depression", "Anxiety", "EmotionalVol", "IntCuriosity", "AesthSense", "CrtvImagination", sit_names)
pp_wide <- pp_mi_range
pp_wide_sit <- pp_mi_range_sit
rm(pp, pp_mi, pp_mi_range)
describe(pp_wide)Warning in FUN(newX[, i], ...): no non-missing arguments to min; returning Inf
Warning in FUN(newX[, i], ...): no non-missing arguments to max; returning -Inf
Warning in FUN(newX[, i], ...): no non-missing arguments to min; returning Inf
Warning in FUN(newX[, i], ...): no non-missing arguments to max; returning -Inf
Code
pomp <- function(x, na){
(x - min(x, na.rm = na))/(max(x, na.rm = na) - min(x, na.rm = na))*100
}
pp_wide_POMP <- pp_wide %>%
mutate(
Sociability = pomp(Sociability, TRUE)
, EnergyLevel = pomp(EnergyLevel, TRUE)
, Assertive = pomp(Assertive, TRUE)
, Trust = pomp(Trust, TRUE)
, Respect = pomp(Respect, TRUE)
, Compassion = pomp(Compassion, TRUE)
, Productivity = pomp(Productivity, TRUE)
, Responsibility = pomp(Responsibility, TRUE)
, Organization = pomp(Organization, TRUE)
, Depression = pomp(Depression, TRUE)
, Anxiety = pomp(Anxiety, TRUE)
, EmotionalVol = pomp(EmotionalVol, TRUE)
, IntCuriosity = pomp(IntCuriosity, TRUE)
, AesthSense = pomp(AesthSense, TRUE)
, CrtvImagination = pomp(CrtvImagination, TRUE)
) %>%
ungroup()
pp_wide_POMP[,5:19] <- round(pp_wide_POMP[,5:19], 2)
#describe(pp_wide) #cool
pp_wide <- pp_wide_POMPPOMP situations df
Code
pp_wide_sit <- pp_wide_sit %>%
mutate(
Sociability = pomp(Sociability, TRUE)
, EnergyLevel = pomp(EnergyLevel, TRUE)
, Assertive = pomp(Assertive, TRUE)
, Trust = pomp(Trust, TRUE)
, Respect = pomp(Respect, TRUE)
, Compassion = pomp(Compassion, TRUE)
, Productivity = pomp(Productivity, TRUE)
, Responsibility = pomp(Responsibility, TRUE)
, Organization = pomp(Organization, TRUE)
, Depression = pomp(Depression, TRUE)
, Anxiety = pomp(Anxiety, TRUE)
, EmotionalVol = pomp(EmotionalVol, TRUE)
, IntCuriosity = pomp(IntCuriosity, TRUE)
, AesthSense = pomp(AesthSense, TRUE)
, CrtvImagination = pomp(CrtvImagination, TRUE)
) %>%
ungroup()
pp_wide_sit[,3:17] <- round(pp_wide_sit[,3:17], 2)Warning in FUN(newX[, i], ...): no non-missing arguments to min; returning Inf
Warning in FUN(newX[, i], ...): no non-missing arguments to max; returning -Inf
[1] 0
[1] 0
[1] 0
[1] 0
LOOK AT VARIABLE VARIANCES
Descriptives
Code
#make it long
pp_long <- pp_wide %>%
pivot_longer(
cols = Sociability:CrtvImagination
, names_to = c("facet")
, values_to = "value"
) %>%
arrange(SID, Date)
# function for mean, sd, median, min, max, n, n missing
descriptive_fun <- function(df, var) {
df %>%
summarize(
mean = mean({{ var }}, na.rm = TRUE),
sd = sd({{ var }}, na.rm = TRUE),
median = median({{ var }}, na.rm = TRUE),
min = min({{ var }}, na.rm = TRUE),
max = max({{ var }}, na.rm = TRUE),
mode = DescTools::Mode({{ var }}, na.rm = TRUE),
# omega = omega({{var}}),
# alpha = alpha({{var}}),
n = n(),
.groups = "drop"
)
}
pp_descriptives <- pp_long %>%
group_by(SID, facet) %>% # we want descriptive for each trait for each participant
descriptive_fun(var = value) %>%
ungroup()Registered S3 method overwritten by 'DescTools':
method from
reorder.factor gdata
Look at no variance participant-variables
Look at low variance participant-variables
Look at median = 0 or 100
Reverse Score Neuroticism